home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / asm / conv_a11.zip / CONV_A1.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-06  |  29KB  |  815 lines
  1. PROGRAM Conv_A;
  2. {$B-}     {shortcut Boolean}
  3. {$D-}     {no debug}
  4. {$L-}     {no local symbols}
  5. {$S-}     {no stack checking}
  6. {$V-}     {no VAR-string checking}
  7.  
  8. Uses Dos,Crt;                {for all the wildcard stuff,
  9.                               and some GotoXY calls}
  10.  
  11. { DEFINE NO_OVERWRITE}   {this enables .FMT file existence checking.
  12.                           I suggest you define it .. that keeps the
  13.                           system from trying to reformat earlier
  14.                           .FMT files during a wildcard run where the user
  15.                           specified *.* or something equally dumb!
  16.                          }
  17.  
  18. {
  19.  Original based on a bulletin board program by Jeff Firestone
  20.  This version based on a program by Douglas S. Stivison in his book:
  21.      'Turbo Pascal Library' published by Sybex.
  22.  
  23.   v1.1, Toad Hall, 5 Nov 89
  24.    - Tightened up POSBM a little (now POSBM2).
  25.    - Moved Uc string uppercase function to EXTERNAL function
  26.      (UC.ASM, UC.OBJ).
  27.    - Fixed bug in TOKSTR_A.PAS (wasn't correctly padding reserved words
  28.      in token strings with spaces).
  29.  
  30.   v1.0, Toad Hall, 13 Oct 89
  31.     - Rewriting UPCONV15.PAS to handle assembly language reserved
  32.       words (operators, instructions, etc.)
  33.  
  34.   David Kirschbaum
  35.   Toad Hall
  36.   kirsch@arsocomvax.socom.mil
  37. }
  38.  
  39.  
  40. CONST
  41.   TokFilename : STRING[10] = 'CONV_A.DAT';  {file of reserved word strings}
  42.  
  43. TYPE
  44.   StrPtr = ^Str_Rec;
  45.   Str_Rec = RECORD
  46.               S : STRING;
  47.               next : Pointer;
  48.             END;
  49.  
  50. VAR
  51.   ReservedWords : StrPtr;               {pointer to first dynamic
  52.                                          reserved word string record}
  53.   UCReserved : StrPtr;                  {pointer to first dynamic uppercase
  54.                                          reserved word string record}
  55.  
  56. CONST
  57.   APOS          = #39;            {This is the ' symbol.}
  58.   QUOTE         = '"';            {This is the " symbol.}
  59.   COMMENT       = ';';            {Assembly language uses semicolon}
  60.  
  61.    {Note: These are the only valid characters that are used in assembly
  62.     language and MASM identifiers, etc.}
  63.   Identifier : SET OF CHAR = ['A'..'Z', '0'..'9', '%','.','?'];
  64.  
  65. VAR
  66.   charP,                   {character pointer}
  67.   linenum,                 {line counter}
  68.   ourX,                    {col coordinate for line counter display}
  69.   quote1P,                 {quote char pointers}
  70.   quote2P    : Word;
  71.  
  72.   Lower,                      {If TRUE, all assembly language instructions
  73.                                lowercased (but not the MASM ones!)}
  74.   AllUpper   : BOOLEAN;       {if TRUE, ALL reserved words uppercased}
  75.  
  76.   UcWord,                               {possible keyword, uppercased}
  77.   Padded     : STRING[20];              {UcWord, padded with spaces}
  78.  
  79.   UProgLine,                            {Uppercased line of source txt}
  80.   CommentLine,                          {Hold comments, quoted text}
  81.   WorkLine,                             {Build formatted output line}
  82.   ProgLine   : STRING;                  {Original line of source txt}
  83.   worklen    : Byte Absolute WorkLine;
  84.  
  85.   RamWord    : STRING [100];
  86.  
  87.   InFile,
  88.   OutFile : TEXT;
  89.  
  90.   CommentCh : CHAR;                     {holds MASM COMMENT char or #0}
  91.  
  92. { Multiple cmdline parm/wildcard stuff }
  93. CONST
  94.   MAXARGS = 10;                         {change as you like}
  95.  
  96. TYPE
  97.   PathStrPtr = ^PathStr;
  98.  
  99. VAR
  100.   Ok : BOOLEAN;
  101.   argv, argc : Byte;
  102.   Args : ARRAY[1..MAXARGS]              {array of cmdline parm ptrs}
  103.            OF PathStrPtr;               {STRING[79]}
  104.  
  105.   Dir : DirStr;                         {STRING[79]}
  106.   Name: NameStr;                        {STRING[8]}
  107.   Ext : ExtStr;                         {STRING[4]}
  108.  
  109.   OutName : PathStr;                    {STRING[79]}
  110.  
  111. {SearchRec is declared in the Dos unit:}
  112. (*
  113.  TYPE SearchRec = RECORD
  114.                     fill : ARRAY[1..21] OF Byte;
  115.                     attr : Byte;
  116.                     time : LongInt;
  117.                     size : LongInt;
  118.                     Name : STRING[12];
  119.                   END;
  120. *)
  121.     SrchRec : SearchRec;
  122.  
  123.  
  124. CONST
  125.   MAXBUFFLINES = 256;                   {seems a likely number}
  126.  
  127. {Our new read/write string buffers}
  128.  
  129. TYPE
  130.   BuffPtr = ^STRING;
  131.   Buffer = ARRAY[1..MAXBUFFLINES] OF BuffPtr;
  132.  
  133. VAR
  134.   InBuff,OutBuff   : Buffer;
  135.   inlines,
  136.   currin, currout  : Word;
  137.  
  138.  
  139. PROCEDURE Usage;
  140.   {Give user help, terminate.
  141.    Happens on cmd line of '?', '-?', '/?', '-h', '/h', or empty.
  142.   }
  143.   BEGIN
  144.     WRITELN(
  145. 'CONV_A v1.1 - Convert assembly language instructions to lower case,');
  146.     WRITELN(
  147. '       If MASM-peculiar reserved words, convert to upper case');
  148.     WRITELN(
  149. 'Usage:  CONV_A [[-][/]U][L] file1[.typ]');
  150.     WRITELN( 'Switches:');
  151.     WRITELN(
  152. ' -u, -U, /u, or /U : uppercase ALL reserved words');
  153.     WRITELN(
  154. ' -l, -L, /l, or /L : lowercase MASM reserved words and ASM instructions');
  155.     WRITELN(
  156. 'Source filename file1 will be forced to .ASM if no type is given.');
  157.     WRITELN(
  158. 'Formatted output filename forced to FILE1.FMT');
  159.     WRITELN('Wildcards may be used for file1.typ');
  160.     HALT;
  161.   END;  {of Usage}
  162.  
  163. {Replacement for POS() function
  164.  Dr Dobbs, Jul 89
  165. }
  166. {Link in the POSBM Boyer-Moore function }
  167.  
  168. {$F+}
  169.  
  170. {$L POSBM2}  {v1.1}
  171.  
  172. FUNCTION posBM(Pat,S : STRING) : Byte; EXTERNAL;
  173.  
  174.  
  175. {Link in the Toad Hall posCh function}
  176. {$L POSCH}
  177.  
  178. FUNCTION posCh(Ch : CHAR; S : STRING) : Byte; EXTERNAL;
  179.  
  180. {v1.1 And the Uc string uppercase function}
  181. {$L UC}
  182.  
  183. FUNCTION Uc(S : STRING) : STRING; EXTERNAL;
  184.  
  185. {$F-}
  186.  
  187.  
  188. PROCEDURE Uc_Str(VAR S : STRING);
  189.   {Same as Uc, but changes the string "in place".}
  190.   BEGIN
  191. InLine(
  192.   $8C/$DB/       {  mov   bx,DS      ;preserve DS}
  193.   $C5/$B6/>S/    {  lds   si,>S[bp]  ;get the VAR addr}
  194.   $31/$C0/       {  xor   ax,ax}
  195.   $8A/$04/       {  mov   al,[si]    ;snarf the length}
  196.   $89/$C1/       {  mov   cx,ax      ;loop counter}
  197.   $E3/$0E/       {  jcxz  Exit       ;zero length, forget it}
  198.                  {;}
  199.   $BA/$61/$20/   {  mov   dx,$2061   ;DL='a',DH=$20}
  200.                  {L1:}
  201.   $46/           {  inc   si         ;next char}
  202.   $8A/$04/       {  mov   al,[si]    ;snarf the char}
  203.   $38/$D0/       {  cmp   al,dl}
  204.   $72/$02/       {  jb    S1         ;already uppercase}
  205.   $28/$34/       {  sub   [si],dh    ;uppercase it}
  206.                  {S1:}
  207.   $E2/$F5/       {  loop  L1}
  208.                  {Exit:}
  209.   $8E/$DB);      {  mov   DS,bx      ;restore DS}
  210.   END;  {of Uc_Str}
  211.  
  212.  
  213. PROCEDURE Lo_Str (VAR S : STRING);
  214.   {Lowercase a string}
  215.   BEGIN
  216. InLine(
  217.   $1E/           {  push  DS}
  218.   $C5/$B6/>S/    {  lds   si,>S[bp]}
  219.   $31/$C0/       {  xor   ax,ax}
  220.   $8A/$04/       {  mov   al,[si];snarf the length}
  221.   $09/$C0/       {  or    ax,ax  ;0 length?}
  222.   $74/$16/       {  je    Exit   ;yep, exit}
  223.  
  224.   $89/$C1/       {  mov   cx,ax}
  225.   $BA/$41/$5A/   {  mov   dx,$5A41  ;DL='A',DH='Z'}
  226.   $B4/$20/       {  mov   ah,$20 ;handy constant}
  227.                  {L1:}
  228.   $46/           {  inc   si     ;next char}
  229.   $8A/$04/       {  mov   al,[si];snarf the char}
  230.   $38/$D0/       {  cmp   al,dl  ;<'A'?}
  231.   $72/$06/       {  jb    S1     ;yep}
  232.   $38/$F0/       {  cmp   al,dh  ;>'Z'?}
  233.   $77/$02/       {  ja    S1     ;yep}
  234.   $00/$24/       {  add   [si],ah  ;lowercase}
  235.                  {S1:}
  236.   $E2/$F1/       {  loop  L1}
  237.                  {Exit:}
  238.   $1F);          {  pop   DS    ;restore}
  239.  
  240.   END;  {of Lo_Str}
  241.  
  242.  
  243. FUNCTION ReadLn_B(VAR S : STRING) : BOOLEAN;
  244.   {Returns a string from our input buffer.
  245.    If buffer is exhausted, refills from InFile.
  246.    Returns FALSE IF (1) buffer is exhausted, and
  247.                     (2) EOF(InFile)
  248.    Else returns TRUE.
  249.   }
  250.   BEGIN
  251.     ReadLn_B := TRUE;                   {assume success}
  252.     Inc(currin);                        {bump to next line}
  253.     IF currin <= inlines THEN BEGIN     {we still have lines in buffer}
  254.       S := InBuff[currin]^;             {return the string}
  255.       Exit;                             {done}
  256.     END;
  257.  
  258.     {We've hit buffer end .. read in a new buffer full
  259.      (or as much as is available).
  260.     }
  261.     currin := 1;                        {start at InBuff[1]}
  262.     inlines := 0;                       {init input buffer string counter}
  263.     WHILE NOT EOF(InFile)               {stop at EOF}
  264.     AND (inlines < MAXBUFFLINES)        {or when input buffer is full}
  265.     DO BEGIN
  266.       Inc(inlines);                     {bump input buffer string counter}
  267.       READLN(InFile,InBuff[inlines]^);  {Read in a buffer string}
  268.                                        {(Let Turbo handle any errors for now)}
  269.     END;
  270.     IF inlines > 0                     {we did read at least one line}
  271.     THEN S := InBuff[currin]^
  272.     ELSE ReadLn_B := FALSE;            {EOF, no lines read}
  273.   END;  {of ReadLn_B}
  274.  
  275.  
  276. PROCEDURE WriteLn_B(S : STRING);
  277.   {Buffered string output.
  278.    Move S to our output buffer OutBuff.
  279.    If OutBuff is full, write it to disk.
  280.   }
  281.   VAR  err : INTEGER;
  282.   BEGIN
  283.     Inc(currout);                       {bump output line counter}
  284.     IF currout > MAXBUFFLINES           {output buffer's full}
  285.     THEN BEGIN
  286.       FOR currout := 1 TO MAXBUFFLINES DO BEGIN
  287. {$I-}
  288.         WRITELN(OutFile,OutBuff[currout]^);  {write to file}
  289.         err := IOResult;
  290. {$I+}
  291.         IF err <> 0 THEN BEGIN
  292.           WRITELN('File Write Error');
  293.           HALT(err);
  294.         END;
  295.       END;
  296.  
  297.       currout := 1;                     {back to output buffer start}
  298.     END;
  299.     OutBuff[currout]^ := S;             {move string into output buffer}
  300.   END;  {of Writeln_B}
  301.  
  302.  
  303. PROCEDURE Flush_OutBuff;
  304.   {If any output strings are left in our output buffer,
  305.    write them to disk.
  306.    (We really should test to see if we've written ANYTHING
  307.    to our output file, and delete it if it's empty (or something).
  308.    Not messing with that for now (since you can't do a FileSize
  309.    on text files, and we'd have to reopen as some other type, etc.).
  310.   }
  311.   VAR
  312.     i : Word;
  313.     err : INTEGER;
  314.   BEGIN
  315.     IF currout > 0                      {if there are any buffer lines}
  316.     THEN FOR i := 1 TO currout DO BEGIN {write them all out}
  317. {$I-}
  318.       WRITELN(OutFile,OutBuff[i]^);
  319.       err := IOResult;
  320. {$I+}
  321.       IF err <> 0 THEN BEGIN
  322.         WRITELN('File Write Error');
  323.         HALT(err);
  324.       END;
  325.  
  326.     END;
  327.     WRITE(OutFile,^Z);                  {terminating ^Z}
  328.  
  329. {$I-}
  330.     CLOSE(InFile);
  331.     CLOSE(OutFile);                     {close up}
  332. {$I+}
  333.     IF IOResult <> 0 THEN ;             {we don't care}
  334.  
  335.   END;  {of Flush_OutBuff}
  336.  
  337.  
  338. PROCEDURE Get_Args;
  339.   {Process command line for all target filenames.
  340.    Move them into a dynamic array of PathStrs.
  341.   }
  342.   VAR Ch : CHAR;
  343.   BEGIN
  344.     argc := ParamCount;
  345.     IF (argc = 0)                       {no parms at all}
  346.     OR (argc > MAXARGS)                 {or more than we can handle}
  347.     THEN Usage;                         {display help, die}
  348.  
  349.     FOR argv := 1 TO argc DO BEGIN
  350.       NEW(Args[argv]);
  351.       Args[argv]^ := Uc(ParamStr(argv)); {snarf parm, (uppercased)}
  352.     END;
  353.  
  354. { The first arg could've been a '-u' or '/u',
  355.   or a '-l' or '/l'.
  356.   Check that out now.  If so, we set a global and skip that arg
  357.   when it comes time to open files.
  358. }
  359.     argv := 0;                          {assume we start at 1}
  360.     Lower := FALSE;
  361.     AllUpper := FALSE;                  {assume no switches}
  362.  
  363.     IF (LENGTH(Args[1]^) = 2)           {2 chars to a switch}
  364.     AND (Args[1]^[1] IN ['-','/'])      {first is a switch char}
  365.     THEN BEGIN                          {we got a switch}
  366.       Ch := Args[1]^[2];                {grab 2d char}
  367.       IF Ch IN ['?','H'] THEN Usage;    {help, die}
  368.  
  369.       IF Ch = 'U' THEN AllUpper := TRUE     {maybe upper switch}
  370.       ELSE IF Ch = 'L' THEN Lower := TRUE;  {or maybe lower}
  371.       IF NOT (AllUpper OR Lower)            {bogus switch}
  372.       THEN WRITELN('Unknown switch: [', Args[1]^, '], ignored!');
  373.  
  374.       Inc(argv);                        {skip 1st arg in any case}
  375.     END;  {if Arg(1) was a switch}
  376.  
  377.   END;  {of Get_Args}
  378.  
  379.  
  380. {$IFDEF NO_OVERWRITE}      {only if we want no overwriting}
  381.  
  382. FUNCTION Exists(Name : PathStr) : BOOLEAN;
  383.   {Returns TRUE if Name exists on current drive:\dir}
  384.   VAR  F : TEXT;
  385.   BEGIN
  386.     Assign(F, Name);
  387.     {$I-}  RESET (F);  {$I+}
  388.     IF IOResult = 0 THEN BEGIN
  389.       Exists := TRUE;
  390.       CLOSE(F);
  391.     END
  392.     ELSE Exists := FALSE;
  393.   END;  {of Exists}
  394.  
  395. {$ENDIF}
  396.  
  397.  
  398. FUNCTION Open_Files : BOOLEAN;
  399.   {Works FindNext if appropriate, else uses a new Arg string.
  400.    Returns TRUE or FALSE  per success/failure.
  401.   }
  402.   VAR  FName : PathStr;
  403.   BEGIN
  404.     Open_Files := FALSE;                {assume failure}
  405.  
  406.     IF SrchRec.Name = '' THEN BEGIN     {time for a new name}
  407.  
  408.       Inc(argv);                        {bump for first/next name}
  409.       IF Args[argv] = NIL THEN Exit;    {all done, return FALSE}
  410.  
  411.       FSplit(Args[argv]^, Dir, Name, Ext);  {split up the new name}
  412.       IF Ext = '' THEN Ext := '.ASM';       {force to .ASM type}
  413.       FName := Dir + Name + Ext;            {build new name}
  414.       FindFirst(FName,ReadOnly OR Archive,SrchRec)  {first time thru}
  415.     END
  416.     ELSE FindNext(SrchRec);             {working a wildcard}
  417.  
  418.     Ok := (DosError = 0);               {from FindFirst or FindNext}
  419.     IF NOT Ok THEN BEGIN                {not found}
  420.       SrchRec.Name := '';               {Flag we need a new arg
  421.                                          and FindFirst}
  422.       Exit;                             {return FALSE}
  423.     END;
  424.  
  425.     FName := Dir + SrchRec.Name;        {new name from FindFirst/FindNext}
  426.     Args[argv]^ := FName;               {Update Args for outside display}
  427.  
  428. {We'll always force the '.FMT' file type for output.}
  429.  
  430.     FSplit(FName, Dir, Name, Ext);
  431.  
  432.     OutName := Name + '.FMT';           {build a new output path
  433.                                          (current drive:\directory) }
  434.  
  435. {$IFDEF NO_OVERWRITE}
  436.  
  437.     IF Exists(OutName) THEN BEGIN       {If .FMT file already exists...}
  438.       WRITELN(Outname + ' already exists .. skipping!');
  439.       Exit;                             {return FALSE}
  440.     END;
  441. {$ENDIF}
  442.  
  443.     Assign(InFile, FName);
  444.     RESET(InFile);                      {open input file}
  445.  
  446.     Assign(OutFile, OutName);
  447.     {$I-}  REWRITE (OutFile);  {$I+}
  448.     Ok := (IOResult = 0);
  449.     IF NOT Ok THEN BEGIN
  450.       CLOSE(InFile);                    {be neat}
  451.       WRITELN('Unable to open file [' + OutName + ']');
  452.     END                                 {return FALSE}
  453.     ELSE BEGIN
  454.       currin := 0;                      {init input string buffer ptr}
  455.       currout := 0;                     {init output string buffer ptr}
  456.       inlines := 0;                     {insure initial input buffer fill}
  457.  
  458.       Open_Files := TRUE;               {return TRUE}
  459.     END;
  460.   END;  {of Open_Files}
  461.  
  462.  
  463. PROCEDURE Build_Reserved_Arrays;
  464.   {Read in our file of reserved word strings.
  465.    Create two linked lists of string records:
  466.    one normal (lowercased assembly language instructions,
  467.                uppercased MASM instructions),
  468.    one all uppercased).
  469.    We just do this once.
  470.   }
  471.   VAR
  472.     p,                     {working string record pointer}
  473.     curr,curruc : StrPtr;  {for current normal and uppercased str recs}
  474.     TokenFile : TEXT;      {file of reserved word strings}
  475.   BEGIN
  476.       ASSIGN(TokenFile,TokFilename);    {file of reserved word strings}
  477.       {$I-}  RESET(TokenFile);  {$I+}    {open it}
  478.       IF IOResult <> 0 THEN BEGIN        {not found .. die}
  479.         WRITELN(TokFilename, ' file not found.  Aborting!');
  480.         HALT(1);                         {die}
  481.       END;
  482.  
  483.       NEW(ReservedWords);               {allocate first reserved string
  484.                                          record}
  485.       ReservedWords^.S := '';           {build first string ptr}
  486.       ReservedWords^.next := NIL;       {no next}
  487.  
  488.       NEW(UcReserved);                  {create first dynamic uppercased
  489.                                          string ptr}
  490.       UcReserved^ := ReservedWords^;    {initialize it also}
  491.  
  492.       curr := ReservedWords;            {point to first string ptr}
  493.       curruc := UcReserved;             {and first uppercased str ptr}
  494.  
  495.       WHILE NOT EOF(TokenFile) DO BEGIN {read in all the strings}
  496.         READLN(TokenFile,curr^.S);      {read in string}
  497.         NEW(p);                         {allocate new normal record}
  498.         curr^.next := p;                {point THIS record to next one}
  499.         curruc^.S := Uc(curr^.S);       {create uppercased reserve word}
  500.         curr := p;                      {bump to next normal record}
  501.  
  502.         NEW(p);                         {allocate new uppercased record}
  503.         curruc^.next := p;              {assume no next uppercase rec}
  504.         curruc := p;                    {bump to next uppercase rec}
  505.       END;
  506.       curr^.S := '';                    {last string is empty}
  507.       curr^.next := NIL;                {..and points nowhere}
  508.       curruc^ := curr^;                 {also empty}
  509.  
  510.       {$I-} CLOSE(TokenFile);  {$I+}    {close up}
  511.       IF IOResult <> 0 THEN ;           {we don't care}
  512.  
  513.     END;  {of Build_Reserved_Arrays}
  514.  
  515.  
  516. PROCEDURE Test_For_Reserved_Words;
  517.   {Test if the current word (RamWord) is a reserved word.
  518.    If so, write its equivalent (uppercased or upper/lower words)
  519.    out to our output file.
  520.    Else just write it as it is.
  521.   }
  522.   VAR
  523.     p,len : Word;
  524.     curruc,                            {uppercased word str ptr}
  525.     curr : StrPtr;                     {reserved word str ptr}
  526.   BEGIN
  527.  
  528.     Padded := ' ' + Uc(RamWord) + ' ';  {Uppercase, bracket with spaces}
  529.     len := LENGTH(RamWord);
  530.  
  531.     curruc := UcReserved;               {ptr to first dynamic uppercased
  532.                                          reserved word string record}
  533.     IF NOT AllUpper                     {not just uppercase}
  534.     THEN curr := ReservedWords          {Upper/lower case array also}
  535.     ELSE curr := UcReserved;
  536.  
  537.     WHILE curruc^.next <> NIL DO BEGIN  {check all the reserved words}
  538.  
  539.       p := posBM(Padded, curruc^.S);    {is this uppercased, padded
  540.                                          word in the reserved word line?}
  541. (*
  542.       p := firstPos(Padded,curruc^.S,0);  {v1.1}
  543. *)
  544.       IF p > 0 THEN BEGIN               {yep, we have a reserved word}
  545.  
  546.         Inc(p);                         {bump past the space}
  547.         IF AllUpper                     {converting to uppercase..}
  548.         THEN Padded := COPY(curruc^.S,  {..so move in the uppercased word}
  549.                             p, len)
  550.         ELSE BEGIN                      {more processing}
  551.           Padded := COPY(curr^.S,       {word per our Reserved table}
  552.                          p, len);       {uppercase or lower}
  553.           IF Lower
  554.           THEN IF Padded = Uc(Padded)   {If the mixed-case Table word
  555.                                          matches the uppercased word..
  556.                                          it's non-MASM...}
  557.             THEN Lo_Str(Padded);        {..so lowercase it}
  558.         END;
  559.         WorkLine := WorkLine + Padded;  {build in WorkLine}
  560.         Exit;                           {don't look at any more lines}
  561.       END;  {if Padded in line}
  562.       curruc := curruc^.next;           {point to next uppercased reserved
  563.                                          word string record}
  564.       curr := curr^.next;               {point to next normal string}
  565.     END;    {line-checking loop}
  566.  
  567. {We checked all the lines, didn't find our RamWord as a Reserved word}
  568.  
  569.     WorkLine := WorkLine + RamWord;     {build WorkLine with orig word}
  570.  
  571.   END;  {of Test_For_Reserved_Words}
  572.  
  573.  
  574.  
  575. PROCEDURE Process_A_Word;
  576.   VAR
  577.     len : Byte;
  578.     strt : Word;
  579.   BEGIN
  580.     strt := charP;                      {remember where we started}
  581.     WHILE ( (Upcase(ProgLine[charP]) IN Identifier)  {it's a legal char}
  582.     AND (charP <= LENGTH (ProgLine) ) ) {and line isn't done}
  583.                                         {Special case:
  584.                                          bp.label  or  si.label}
  585.     AND NOT ((ProgLine[charP] = '.') AND (charP > strt) )
  586.     DO  Inc(charP);                     {bump ProgLine ptr}
  587.  
  588.     len := (charP - strt);              {nr chars in word}
  589.     RamWord[0] := CHAR(len);            {force string length}
  590.     Move(ProgLine[strt], RamWord[1], len);  {copy portion of ProgLine
  591.                                              into a working string}
  592.  
  593.     Test_For_Reserved_Words;            {check RamWord for reserved words,
  594.                                          maybe add to WorkLine}
  595.   END;  {of Process_A_Word}
  596.  
  597.  
  598. PROCEDURE Process_COMMENT;
  599.   {Handle any COMMENT directives.
  600.    This assumes our comment end will be a separate line
  601.    without any real code or data.
  602.    Bad assumption, I know .. but for the time being...
  603.   }
  604.   VAR  p : WORD;
  605.   BEGIN
  606.     UProgLine := Uc(ProgLine);          {produce uppercased source line}
  607.  
  608.     charP := posBM('COMMENT',UProgLine);  {check for COMMENT ~}
  609. (*
  610.     charP := firstpos('COMMENT',UProgLine,0);
  611. *)
  612.     IF charP = 0 THEN Exit;             {forget it}
  613.  
  614.     {maybe we have one, but could be "comment_str" or some such.
  615.      We'll snarf the potential " COMMENT ".
  616.      If first word in line, there won't be a leading space; we'll add one.
  617.      If not really COMMENT, there'll be no leading whitespace
  618.      or trailing whitespace.
  619.      Proper " COMMENT " should be 9 chars long, leading and trailing
  620.      whitespace.
  621.      We'll snarf one MORE than that to be sure line is long enough
  622.      for the actual comment character.
  623.      }
  624.  
  625.     IF (charP = 1)                      {first word in line}
  626.     THEN RamWord := ' ' + COPY(UProgLine,1,9)  {add leading space}
  627.     ELSE RamWord := COPY(UProgLine,PRED(charP),10);  {snarf char before}
  628.  
  629.     IF (LENGTH(RamWord) < 10)           {not long enough for " COMMENT ~"}
  630.     OR NOT (RamWord[1] IN [#$20,#$09])  {leading char must be space or tab}
  631.     OR NOT (RamWord[9] IN [#$20,#$09])  {separator must be space or tab}
  632.     THEN Exit;                          {forget it}
  633.  
  634.     {Truly a COMMENT.  However, there may be more than one whitespace
  635.      between "COMMENT" and the comment character.
  636.     }
  637.     p := charP + 7;                     {point past "COMMENT"}
  638.     CommentCh := ProgLine[p];           {snarf next char}
  639.  
  640.     WHILE (p <= LENGTH(ProgLine))       {until EOL}
  641.     AND (CommentCh IN [#$20,#$09])      {white space}
  642.     DO BEGIN
  643.       CommentCh := ProgLine[p];         {snarf next char}
  644.       Inc(p);                           {bump ptr}
  645.     END;
  646.  
  647.     IF (p > LENGTH(ProgLine))           {hit EOL}
  648.     AND (CommentCh IN [#$20,#$09])      {didn't get real comment token}
  649.     THEN BEGIN
  650.       Writeln;                          {end counter display line}
  651.       Writeln('Comment error at line ', linenum);  {error msg}
  652.       GotoXY(ourX,WhereY);              {reposition to correct col}
  653.       WRITE('Processing line: ');       {redisplay counter display}
  654.       Exit;                             {process as "normal" source code}
  655.     END;
  656.  
  657.     {truly a COMMENT line}
  658.     IF Lower THEN RamWord := 'comment'
  659.     ELSE RamWord := 'COMMENT';
  660.     Move(RamWord[1],ProgLine[charP],7); {fix COMMENT word}
  661.  
  662.     Writeln_B(ProgLine);                {write out the entire line}
  663.  
  664.     WHILE ReadLn_B(ProgLine)            {new line, not EOF}
  665.     AND (CommentCh <> #0)               {last line wasn't last comment line}
  666.     DO BEGIN
  667.       Writeln_B(ProgLine);              {so write out comment}
  668.       WRITE(linenum:6,^H^H^H^H^H^H);    {display, back up}
  669.       Inc(linenum);                     {bump linenr}
  670.       IF posCh(CommentCh,ProgLine) <> 0 {last COMMENT line}
  671.       THEN CommentCh := #0;             {clear as a flag to exit next loop}
  672.     END;
  673.  
  674.   END;  {of Process_COMMENT}
  675.  
  676.  
  677. PROCEDURE Process_Quotes;
  678.   {Process any ";" comments, quotes, etc.}
  679.   BEGIN
  680.     charP := posCh(COMMENT,ProgLine);   {find first ';'}
  681.     IF charP = 1 THEN BEGIN             {entire line is commented}
  682.       CommentLine := ProgLine;          {so move into CommentLine for write}
  683.       ProgLine := '';                   {nothing left}
  684.       Exit;                             {all done}
  685.     END;
  686.  
  687.     IF charP <> 0 THEN BEGIN            {commented within line}
  688.                                         {save commented txt}
  689.       CommentLine := COPY(ProgLine,charP,LENGTH(ProgLine));
  690.       Delete(ProgLine,charP,LENGTH(ProgLine));  {delete commented txt}
  691.     END;
  692.  
  693. { Process remaining line for Quoted text,
  694.   handling "nested" quotation marks to pick up the first one.
  695. }
  696.     charP := 0;                         {init quote pointer}
  697.  
  698.     quote1P  := posCh(APOS,ProgLine);   {find first '''}
  699.     quote2P  := posCh(QUOTE,ProgLine);  {find first '"'}
  700.  
  701.     IF quote1P <> 0 THEN BEGIN          {we have a '}
  702.       IF quote2P = 0                    {no " quote}
  703.       THEN charP := quote1P             {so mark first quote}
  704.       ELSE IF quote1P < quote2P         {we have both quotes}
  705.       THEN charP := quote1P             {and ' comes before "}
  706.       ELSE charP := quote2P;            {we have both quotes
  707.                                          and " comes before '}
  708.     END
  709.     ELSE IF quote2P <> 0 THEN BEGIN     {we have a "}
  710.       IF quote1P = 0                    {no ' quote}
  711.       THEN charP := quote2P             {so mark first quote}
  712.       ELSE IF quote2P < quote1P         {we have both quotes}
  713.       THEN charP := quote2P             {and " comes before '}
  714.       ELSE charP := quote1P;            {we have both quotes
  715.                                          and ' comes before "}
  716.     END;
  717.     IF (charP <> 0) THEN BEGIN          {we have quoted text}
  718.       CommentLine := COPY(ProgLine,charP,LENGTH(ProgLine))  {Put quoted}
  719.                      + CommentLine;             { txt before Commented txt}
  720.       Delete(ProgLine,charP,LENGTH(ProgLine));  {delete Quoted text}
  721.     END;
  722.   END;  {of Process_Quotes}
  723.  
  724.  
  725. PROCEDURE Convert;
  726.   VAR
  727.     Ch : CHAR;
  728.     p : INTEGER;
  729.   BEGIN
  730.     WRITE('Converting ', Args[argv]^, ' => ', OutName,', ');
  731.     ourX := WhereX;                     {pick up current col coord}
  732.     WRITE('Processing line: ');
  733.  
  734.     linenum := 1;
  735.  
  736.     WHILE ReadLn_B(ProgLine) DO BEGIN   {buffered string input
  737.                                          FALSE means EOF}
  738.       WorkLine := '';                   {initialize working line}
  739.       CommentLine := '';                {and commentline}
  740.  
  741.       IF LENGTH(ProgLine) <> 0 THEN BEGIN     {nonblank line}
  742.  
  743.         Process_COMMENT;                {handle any COMMENT lines}
  744.         IF LENGTH(ProgLine) <> 0        {we have a line to process}
  745.         THEN Process_Quotes;            {handle any ";" comments or quotes}
  746.  
  747. {Process remaining line (if any) for reserved words}
  748.  
  749.         charP := 1;
  750.         WHILE charP <= LENGTH(ProgLine) DO BEGIN
  751.           Ch := UProgLine[charP];       {next uppercased prog char}
  752.           IF Ch IN Identifier           {could be a reserved word}
  753.           THEN Process_A_Word           {process possible reserved word}
  754.           ELSE BEGIN
  755.  
  756.             Inc(worklen);               {bump WorkLine length}
  757.             WorkLine[worklen] := Ch;    {stuff char in WorkLine}
  758. (* Same as
  759.             WorkLine := WorkLine + Ch;
  760.    but tighter, faster
  761. *)
  762.             Inc(charP);                 {bump ptr}
  763.           END;  {non-identifier char}
  764.         END;  {WHILE processing remaining non-commented, non-quoted text}
  765.       END; {If nonblank ProgLine}
  766.  
  767.       Writeln_B(WorkLine + CommentLine); {buffered string output}
  768.  
  769.       WRITE(linenum:6,^H^H^H^H^H^H);    {display, back up}
  770.       Inc(linenum);                     {bump linenr}
  771.     END;  {While}
  772.  
  773.     WRITELN;                            {clean up screen}
  774.  
  775.     Flush_OutBuff;                      {flush output buffer,
  776.                                          close up everything}
  777.   END;  {of Convert}
  778.  
  779.  
  780. BEGIN  {main}
  781.  
  782.   Get_Args;                             {process cmdline args
  783.                                          (may die)}
  784.   Build_Reserved_Arrays;                {build two linked lists
  785.                                          of reserved word records
  786.                                          (one normal, one uppercased) }
  787.  
  788.   {So far, so good.  Initialize our dynamic input and output
  789.    buffer array pointers.
  790.    Later, check for avail memory, constrain buffers, etc.
  791.   }
  792.  
  793.   FOR currin := 1 TO MAXBUFFLINES DO
  794.     NEW(InBuff[currin]);
  795.   FOR currout := 1 TO MAXBUFFLINES DO
  796.     NEW(OutBuff[currout]);
  797.  
  798. {Now we go into our file loop.
  799.  We continue until FindNext returns no more files.
  800.  Get_Args set argv appropriately.
  801. }
  802.  
  803.   SrchRec.Name := '';                   {clear for first file}
  804.  
  805.   WHILE (SrchRec.Name <> '')            {we're working a wildcard}
  806.   OR (argv < argc)                      {no wildcard, but still got args}
  807.   DO BEGIN
  808.  
  809.     IF Open_Files                       {open InFile,OutFile}
  810.     THEN Convert;                       {files open, do the conversion}
  811.  
  812.   END;  {until all done}
  813.  
  814. END.
  815.